perm filename CLOSE.1[AID,LSP]1 blob sn#559612 filedate 1981-01-26 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 Helps close files that are randomly open
C00005 ENDMK
C⊗;
;;; Helps close files that are randomly open
(declare (fasload util fas dsk (aid rpg)))

(macrodef real-tyi ()
 (while (member (tyipeek) '(13. 10.)) do (tyi)) (tyi))

(declare (special close-file-start-address))

(setq close-file-start-address (getddtsym 'chntb))
;(cond ((status features onesegment)
;       (cond ((status features paging)
;	      (setq close-file-start-address 149.))
;	     (t (setq close-file-start-address 190.))))
;      (t (cond ((status features ddt) (setq close-file-start-address 6846.))
;	       (t (setq close-file-start-address 190.)))))

(defun closer ()
 (let file ← nil 
      end ← (+ close-file-start-address 17.)
      lm ← (status linmode) do
      (sstatus linmode nil)
      (do ((i close-file-start-address (1+ i)))
	  ((= i end) t)
	  (setq file (munkam (examine i)))
	  (and file
	       (not (member 'tty (car (status filemode file))))
	       (progn (terpri)
		      (princ file)
		      (princ '| - Close this one? |)
		      (member (real-tyi) '(89. 121.)))
	       (progn (close file) (terpri) (princ file) (princ '| closed!|))))
      (sstatus linmode lm)
      (terpri)
      'done))   

(defun closeall ()
 (let file ← nil 
      end ← (+ close-file-start-address 17.)
      do
      (do ((i close-file-start-address (1+ i)))
	  ((= i end) t)
	  (setq file (munkam (examine i)))
	  (and file
	       (not (member 'tty (car (status filemode file))))
	       (progn (close file) (terpri) (princ file) (princ '| closed!|))))
      (terpri)
      'done))